home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ape-ad1a / cdxvbmap.cls < prev    next >
Text File  |  1999-09-20  |  5KB  |  177 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "CDXVBMap"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = True
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. ' Only works for 64*64 tiles at the moment, and only a screen res of 640*480
  15.  
  16. Public px, py As Integer
  17. Public bx, by As Integer
  18.  
  19. Public X_BOUND As Long
  20. Public Y_BOUND As Long
  21.  
  22. Private Map() As Integer
  23. Private Tiles() As New CDXVBSurface
  24.  
  25. Public m_TileWidth As Long
  26. Public m_TileHeight As Long
  27.  
  28. Public Sub Create(FN As String, MapWidth As Integer, MapHeight As Integer, ScreenWidth As Integer, ScreenHeight As Integer, NoOfTiles As Integer, TileAdds() As String, DDraw As CDXVBScreen, TileW As Long, TileH As Long)
  29.       Dim char As String
  30.       
  31.       ' Resize the map to given size
  32.       ReDim Map(MapWidth, MapHeight)
  33.       ' Resize the tiles array to the number of tiles there are
  34.       ReDim Tiles(1 To NoOfTiles)
  35.       
  36.       m_TileWidth = TileW
  37.       m_TileHeight = TileH
  38.       
  39.       ' Load map file into array
  40.       Open FN For Binary As #1
  41.             For Y = 0 To MapHeight
  42.                   For X = 0 To MapWidth
  43.                         char = " "
  44.                         Get #1, 1 + Y * (MapWidth + 2) + X, char
  45.                         
  46.                         If IsNumeric(char) Then Map(X, Y) = char
  47.                   Next X
  48.             Next Y
  49.       Close #1
  50.       
  51.       ' Set map boundaries
  52.       X_BOUND = MapWidth * m_TileWidth
  53.       Y_BOUND = MapHeight * m_TileHeight
  54.       
  55.       ' Set screen boundaries
  56.       px = 0
  57.       py = 0
  58.       bx = ScreenWidth
  59.       by = ScreenHeight
  60.       
  61.       ' Load up bitmaps into tiles
  62.       For i = 1 To UBound(Tiles, 1)
  63.             Tiles(i).Create TileAdds(i), DDraw
  64.       Next i
  65. End Sub
  66.  
  67. Public Sub Draw(Back As IDirectDrawSurface2, ClipLeft As Long, ClipTop As Long, ClipRight As Long, ClipBottom As Long)
  68.       ' Height in tiles
  69.       For Y = Int(py / m_TileHeight) To Int((by - 1) / m_TileHeight)
  70.             ' Width in tiles
  71.             For X = Int(px / m_TileWidth) To Int((bx - 1) / m_TileWidth)
  72.                   If Not Tiles(Map(X, Y)) Is Nothing Then
  73.                         DrawTile Back, Tiles(Map(X, Y)), X * m_TileWidth - px, Y * m_TileHeight - py, ClipLeft, ClipTop, ClipRight, ClipBottom
  74.                   End If
  75.             Next X
  76.       Next Y
  77. End Sub
  78.  
  79. Private Sub DrawTile(Dest As IDirectDrawSurface2, Tile As CDXVBSurface, X As Long, Y As Long, ClipLeft As Long, ClipTop As Long, ClipRight As Long, ClipBottom As Long)
  80.       Dim rcRect As RECT
  81.       Dim Diff As Long
  82.       
  83.       With rcRect
  84.             .top = 0
  85.             .left = 0
  86.             .bottom = m_TileHeight
  87.             .right = m_TileWidth
  88.       End With
  89.       
  90.       ' Check to see if the tile is on the screen
  91.       If X + rcRect.right < ClipLeft Then Exit Sub
  92.       If X > ClipRight Then Exit Sub
  93.       If Y + rcRect.bottom < ClipTop Then Exit Sub
  94.       If Y > ClipBottom Then Exit Sub
  95.       
  96.       ' Left side
  97.       If X < ClipLeft Then
  98.             Diff = Abs(X - ClipLeft)
  99.             rcRect.left = rcRect.left + Diff
  100.             X = ClipLeft
  101.       End If
  102.       ' Top side
  103.       If Y < ClipTop Then
  104.             Diff = Abs(Y - ClipTop)
  105.             rcRect.top = rcRect.top + Diff
  106.             Y = ClipTop
  107.       End If
  108.       ' Right side
  109.       If X + rcRect.right > ClipRight Then rcRect.right = ClipRight - X + rcRect.left
  110.       ' Bottom side
  111.       If Y + rcRect.bottom > ClipBottom Then rcRect.bottom = ClipBottom - Y + rcRect.top
  112.  
  113.       ' Error fixing
  114.       If rcRect.bottom = 0 Then Exit Sub
  115.       If rcRect.right = 0 Then Exit Sub
  116.       If Not rcRect.bottom > rcRect.top Then Exit Sub
  117.       If Not rcRect.right > rcRect.left Then Exit Sub
  118.  
  119.       ' Set clipping rectangle
  120.       Tile.SetSrc rcRect.top, rcRect.left, rcRect.bottom, rcRect.right
  121.  
  122.       Tile.Blit X, Y, Dest
  123. End Sub
  124.  
  125. Public Sub MoveUp(Amt As Integer)
  126.       py = py - Amt
  127.       by = by - Amt
  128.  
  129.       If (py < 0) Then py = 0: by = by + Amt
  130. End Sub
  131.  
  132. Public Sub MoveDown(Amt As Integer)
  133.       py = py + Amt
  134.       by = by + Amt
  135.  
  136.       If (by > Y_BOUND) Then by = Y_BOUND: py = py - Amt
  137. End Sub
  138.  
  139. Public Sub MoveLeft(Amt As Integer)
  140.       px = px - Amt
  141.       bx = bx - Amt
  142.  
  143.       If (px < 0) Then px = 0: bx = bx + Amt
  144. End Sub
  145.  
  146. Public Sub MoveRight(Amt As Integer)
  147.       px = px + Amt
  148.       bx = bx + Amt
  149.  
  150.       If (bx > X_BOUND) Then bx = X_BOUND: px = px - Amt
  151. End Sub
  152.  
  153. Public Sub Clear()
  154.       For X = 0 To UBound(Map, 1)
  155.             For Y = 0 To UBound(Map, 2)
  156.                   Map(X, Y) = 0
  157.             Next Y
  158.       Next X
  159. End Sub
  160.  
  161. Public Sub Fill(TileNo As Integer)
  162.       For X = 0 To UBound(Map, 1)
  163.             For Y = 0 To UBound(Map, 2)
  164.                   Map(X, Y) = TileNo
  165.             Next Y
  166.       Next X
  167. End Sub
  168.  
  169. Public Sub PutTile(X As Integer, Y As Integer, TileNo As Integer)
  170.       Map(X, Y) = TileNo
  171. End Sub
  172.  
  173. Public Function GetTile(X As Integer, Y As Integer) As Integer
  174.       GetTile = Map(X, Y)
  175. End Function
  176.  
  177.